home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Night Owl 9
/
Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO
/
015a
/
tm20.zip
/
TM.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-03-19
|
3KB
|
145 lines
(*
* tm - simple replacement for Norton's TM utility
* S.H.Smith, 29-jan-89; public domain material.
*
*)
{$m 2000,0,0}
{$r-}
uses CRT,DOS;
procedure p2(c: char; n: integer);
begin
write(c);
if n < 10 then
write('0');
write(n);
end;
const
days: array[0..6] of string[3] = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
var
i: integer;
par: string;
msg: string;
left: boolean;
prompt: boolean;
h,m,s,s100: word;
d,y,dw: word;
procedure prompt_for_message;
const
timeout = 3 * 182; {30 seconds}
var
clock: longint absolute 0:$46c;
start: longint;
res: string;
c: char;
con: text;
begin
while keypressed do
c := readkey;
assign(con,'con');
rewrite(con);
res := '';
write(con,msg,'? ');
c := '?';
start := clock;
repeat
if keypressed then
begin
c := readkey;
if c = ^H then
begin
if res <> '' then
begin
dec(res[0]);
write(con,^H' '^H);
end;
end
else
if c <> ^M then
begin
res := res + c;
write(con,c);
end;
end
else
if clock > start+timeout then
begin
res := res + '<unknown>';
c := ^M;
end;
until c = ^M;
msg := res;
writeln(con);
close(con);
end;
begin
if paramcount = 0 then
begin
writeln('TM 2.0, Samuel H. Smith, Public domain material.');
writeln('Usage: TM [/LOG] [/L] [/P] [''message''] [>outfile]');
halt(1);
end;
left := false;
prompt := false;
msg := '';
for i := 1 to paramcount do
begin
par := paramstr(i);
if par[1] = '/' then
begin
if (par = '/L') or (par = '/l') then
left := true
else
if (par = '/P') or (par = '/p') then
prompt := true;
end
else
if (par = 'start') or (par = 'stop') or (par = 'report') or
(par = 'START') or (par = 'STOP') or (par = 'REPORT') then
else
if (par[1] = '''') or (par[1] = '"') then
msg := par
else
if msg = '' then
msg := par
else
msg := msg + ' ' + par;
end;
if (msg[1] = '"') or (msg[1] = '''') then
msg := copy(msg,2,length(msg)-2);
if prompt then
prompt_for_message;
if left then
while length(msg) < 56 do
msg := msg + ' ';
write(msg:56);
GetTime(h,m,s,s100);
p2(' ',h); p2(':',m); p2(':',s);
GetDate(y,m,d,dw);
write(', ',days[dw]);
p2(' ',m); p2('-',d); p2('-',y-1900);
writeln;
end.